Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/portsn1a/portfind.frm

Visual Basic Form | 1999-10-04 | 7.5 KB | 266 lines

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmPortFind
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Port Finder"
   ClientHeight    =   2220
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   3255
   Icon            =   "portfind.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2220
   ScaleWidth      =   3255
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Visible         =   0   'False
   Begin VB.CommandButton Command1
      Caption         =   "Start"
      Height          =   495
      Left            =   2280
      TabIndex        =   0
      Top             =   120
      Width           =   855
   End
   Begin VB.CheckBox Check1
      Caption         =   "Stop After First Find"
      Height          =   195
      Left            =   120
      TabIndex        =   11
      Top             =   1560
      Width           =   1695
   End
   Begin VB.TextBox Text4
      Height          =   285
      Left            =   960
      TabIndex        =   10
      Text            =   "5"
      Top             =   1200
      Width           =   375
   End
   Begin VB.TextBox Text2
      Height          =   285
      Left            =   1080
      TabIndex        =   4
      Top             =   480
      Width           =   375
   End
   Begin VB.TextBox Text3
      Height          =   285
      Left            =   1800
      TabIndex        =   6
      Top             =   480
      Width           =   375
   End
   Begin VB.OptionButton Option2
      Caption         =   "Try Ports"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   480
      Value           =   -1  'True
      Width           =   1095
   End
   Begin VB.OptionButton Option1
      Caption         =   "Try All Ports (1-32767)"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   840
      Width           =   1935
   End
   Begin MSWinsockLib.Winsock sock
      Left            =   1560
      Top             =   1080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   327681
   End
   Begin VB.TextBox Text1
      Height          =   285
      Left            =   960
      TabIndex        =   2
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label3
      Caption         =   "Wait (sec):"
      Height          =   255
      Left            =   120
      TabIndex        =   9
      Top             =   1200
      Width           =   855
   End
   Begin VB.Label Label4
      Caption         =   "to"
      Height          =   255
      Left            =   1560
      TabIndex        =   5
      Top             =   480
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "Search IP:"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label2
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      Caption         =   "No Connections"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      ToolTipText     =   "Click For All Info"
      Top             =   1920
      Width           =   3015
   End
Attribute VB_Name = "frmPortFind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public NumWait As Integer    'how many secs to wait for response
Public UpperB As Integer
 Const HWND_TOP = 0
 Const HWND_TOPMOST = -1
 Const HWND_NOTOPMOST = -2
 Const SWP_NOMOVE = &H2
 Const SWP_NOSIZE = &H1
 Const flags = SWP_NOMOVE Or SWP_NOSIZE
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Dim LowerB As Integer
Dim PortFound As Boolean
Dim StopSrch As Boolean
Dim FirstRun As Boolean
Dim StopIt As Boolean
Sub stayontop(the As Form)
SetWinOnTop = SetWindowPos(the.hWnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
End Sub
Private Sub Command1_Click()
If sock.State <> 0 Then
    sock.Close
    Do Until sock.State = 0
        DoEvents
    Loop
End If
If Command1.Caption = "Start" Then
    Command1.Caption = "Stop"
PortFound = False
FirstRun = True
If Check1.Value = 1 Then
    StopSrch = True
    StopSrch = False
End If
If Option2.Value = True Then
    If Text2.Text <> "" And Text3.Text <> "" Then
        UpperB = Int(Val(Text3.Text))
        LowerB = Int(Val(Text2.Text))
    Else
        MsgBox "Must Specify Ports To Find", vbExclamation + vbMsgBoxSetForeground + vbOKOnly, "Port Finder"
    End If
ElseIf Option1.Value = True Then
    UpperB = 32767
    LowerB = 1
End If
If Text4.Text = "" Then
    Text4.Text = "5"
End If
NumWait = Int(Val(Text4.Text))
Label2.Caption = "Scanning Ports..."
sock.RemoteHost = Text1.Text
sock.LocalPort = 0
For qw% = LowerB To UpperB
    If StopIt = True Then
          Command1.Caption = "Start"
          Label2.Caption = "Canceled...No Connections"
          StopIt = False
            Exit Sub
    End If
    sock.Connect sock.RemoteHost, qw%
    start = 0
    start = (Timer)
    Do Until sock.State = 7
        If StopIt = True Then
            Command1.Caption = "Start"
            Label2.Caption = "Canceled...No Connections"
              StopIt = False
            Exit Sub
        End If
        DoEvents
        If (Timer) - (start) >= NumWait Then
            sock.Close
            Do Until sock.State = 0
                DoEvents
                If StopIt = True Then
                    Command1.Caption = "Start"
                    Label2.Caption = "Canceled...No Connections"
                    StopIt = False
                    Exit Sub
                End If
            Loop
            Exit Do
        End If
    Loop
    If sock.State = 7 Then
        If FirstRun = True Then
            Label2.Caption = "Open port found: " & qw%
        Else
            Label2.Caption = Label2.Caption & ", " & qw%
        End If
        PortFound = True
        FirstRun = False
        sock.Close
        Do Until sock.State = 0
            DoEvents
        Loop
        If StopSrch = True Then
                Exit For
        End If
    End If
Next qw%
If PortFound = False Then
    Label2.Caption = "No Ports Found"
End If
Label2.Caption = Label2.Caption & "  ...Done"
    'stop
    StopIt = True
End If
If Command1.Caption = "Start" Then
    Command1.Caption = "Stop"
    Exit Sub
ElseIf Command1.Caption = "Stop" Then
    Command1.Caption = "Start"
End If
End Sub
Private Sub Command2_Click()
End Sub
Private Sub Form_Activate()
stayontop Me
End Sub
Private Sub Form_Load()
StopIt = False
sock.Protocol = sckTCPProtocol
Me.Visible = True
stayontop Me
End Sub
Private Sub Form_Resize()
stayontop Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
sock.Close
Do Until sock.State = 0
    DoEvents
Cancel = False
End Sub
Private Sub Label2_Click()
MsgBox "" & Label2.Caption & "", vbMsgBoxSetForeground + vbOKOnly, "Port Finder"
End Sub
Private Sub Label5_Click()
End Sub